Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/ras_api/rascomp.pas

Pascal/Delphi Source File | 1995-12-22 | 11.2 KB | 404 lines

unit RASComp;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, RAS_API;

{ ********************************************************************** }
{ ********************************************************************** }

const
  MaxConnections = 4;

type
  TConnectionList = class(TList)
    function AddConnection(Connection: TRASConn): Word;
    function RASConn(Index: Integer): HRASConn;
    function EntryName(Index: Integer): String;
    procedure Delete(Index: Integer);
  end;

  TRAS = class(TComponent)
  private
    { Private declarations }
    fEntryName,
    fPhoneNumber,
    fPhoneBookPath,
    fCallbackNumber,
    fUserName,
    fPassword,
    fDomain,
    fDeviceType,
    fDeviceName: String;
    fOnCallback,
    fOnConnect,
    fOnDisconnect: TNotifyEvent;
    fWindowHandle: HWND;
    RASEvent: Word;

    procedure SetPhoneBookPath(Value: String);
    procedure Connected;
    procedure DisConnected;
    procedure WaitingForCallBack;
    procedure WndProc(var Msg: TMessage);
    function IntDisConnect: LongInt; { Used internally to bypass fOnDisconnect }
  protected
    { Protected declarations }
  public
    { Public declarations }
    PhoneBookEntries: TStringList;
    Connections: TConnectionList;
    LastError: LongInt;
    RASConn: HRASConn;   { Connection handle}
    ConnectState: Word;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetConnectStatus: LongInt;
    function DisConnect: LongInt;
    function GetErrorString(ErrorCode: LongInt): String;
    function Connect: LongInt;
    function CurrentStatus: String;
    function GetConnections: LongInt;
    function GetPhoneBookEntries: LongInt;
  published
    { Published declarations }
    property EntryName: String read fEntryName write fEntryName;
    property PhoneNumber: String read fPhoneNumber write fPhoneNumber;
    property PhoneBookPath: String read fPhoneBookPath write SetPhoneBookPath;
    property CallbackNumber: String read fCallbackNumber write fCallbackNumber;
    property UserName: String read fUserName write fUserName;
    property Password: String read fPassword write fPassword;
    property Domain: String read fDomain write fDomain;
    property DeviceType: String read fDeviceType write fDeviceType;
    property DeviceName: String read fDeviceName write fDeviceName;
    property OnConnect: TNotifyEvent read fOnconnect write fOnConnect;
    property OnDisconnect: TNotifyEvent read fOnDisconnect write fOnDisconnect;
    property OnCallBack: TNotifyEvent read fOnCallBack write fOnCallBack;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('RAS', [TRAS]);
end;

{ ********************************************************************* }
{                           TConnectionList                             }
{ ********************************************************************* }
function TConnectionList.AddConnection(Connection: TRASConn): Word;
var
  Conn: PRASConn;
begin
  Conn := New(PRASConn);
  Conn^ := Connection;
  Add(Conn);
end;

function TConnectionList.RASConn(Index: Integer): HRASConn;
begin
  Result := PRASConn(Items[Index])^.RASConn;
end;

function TConnectionList.EntryName(Index: Integer): String;
begin
  If PRASConn(Items[Index])^.szEntryName[0] <> #0 THEN
     Result := StrPas(PRASConn(Items[Index])^.szEntryName)
  ELSE
     Result := '';
end;

procedure TConnectionList.Delete(Index: Integer);
begin
  Dispose(PRASConn(Items[Index]));
  Items[Index] := Nil;
  inherited Delete(Index);
end;

{ ********************************************************************* }
{                            TRASConnection                             }
{ ********************************************************************* }
constructor TRAS.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RASEvent := RegisterWindowMessage(RASDialEvent);
  If RASEvent = 0 THEN
     RASEvent := WM_RASDialEvent;
  RASConn := 0;
  ConnectState := 0;
  fWindowHandle := 0;
  PhoneBookEntries := TStringList.Create;
  Connections := TConnectionList.Create;
end;

destructor TRAS.Destroy;
begin
  IntDisconnect;
  PhoneBookEntries.Free;
  Connections.Free;
  inherited Destroy;
end;

function TRAS.Connect: LongInt;
var
  RASDialParams: TRASDialParams;{ points to calling parameters }
  R: LongInt;
  Blank: String;
begin
  If RASConn <> 0 THEN { Allow only one connection }
     IntDisConnect;
  If fWindowHandle = 0 THEN
     fWindowHandle := AllocateHWnd(WndProc);
  FillChar(RASDialParams, SizeOf(RASDialParams), #0);
  With RASDialParams DO
  Begin
    dwSize := SizeOf(RASDialParams);
    Blank := fEntryName + #0;
    StrLCopy(szEntryName, @Blank[1], RAS_MaxEntryName);
    Blank := fPhoneNumber + #0;
    StrLCopy(szPhoneNumber, @Blank[1], RAS_MaxPhoneNumber);
    Blank := fCallBackNumber + #0;
    StrLCopy(szCallbackNumber, @Blank[1], RAS_MaxCallbackNumber);
    Blank := fUserName + #0;
    StrLCopy(szUserName, @Blank[1], UNLEN);
    Blank := fPassWord + #0;
    StrLCopy(szPassword, @Blank[1], PWLEN);
    Blank := fDomain + #0;
    StrLCopy(szDomain, @Blank[1], DNLEN);
  End;
  If fPhoneBookPath <> '' THEN
  Begin
    Blank := fPhoneBookPath + #0;
    LastError := RasDial(Nil, @Blank[1], @RASDialParams, Nil, fWindowHandle, RASConn);
  End
  ELSE
    LastError := RasDial(Nil, Nil, @RASDialParams, Nil, fWindowHandle, RASConn);
  Result := LastError;
end;

function TRAS.GetErrorString(ErrorCode: LongInt): String;
var
  szErrorString: Array[0..256] of Char;
begin
  Result := '';
  If (RASConn = 0) THEN
     Exit;
  FillChar(szErrorString, SizeOf(szErrorString), #0);
  RasGetErrorString(ErrorCode, szErrorString, 256);
  If szErrorString[0] <> #0 THEN
     Result := StrPas(szErrorString)
  Else
     Result := 'Status Unknown';
end;

function TRAS.Disconnect: LongInt;
begin
  Result := 0;
  If RASConn <> 0 THEN
     Result := RASHangUp(RASConn);
  RASConn := 0;
  If fWindowHandle <> 0 THEN { Stop message flow }
  Begin
    DeallocateHWnd(fWindowHandle);
    fWindowHandle := 0;
  End;
  LastError := Result;
  Disconnected;
end;

function TRAS.IntDisconnect: LongInt;
begin
  Result := 0;
  If RASConn <> 0 THEN
     Result := RASHangUp(RASConn);
  RASConn := 0;
  If fWindowHandle <> 0 THEN { Stop message flow }
  Begin
    DeallocateHWnd(fWindowHandle);
    fWindowHandle := 0;
  End;
  LastError := Result;
end;

function TRAS.GetConnectStatus: LongInt;
var
  RASConnStatus: TRASConnStatus;
begin
  If (RASConn = 0) THEN
     Exit;
  FillChar(RASConnStatus, SizeOf(RASConnStatus), #0);
  RASConnStatus.dwSize := 60;
  LastError := RasGetConnectStatus(RASConn, @RASConnStatus);
  If LastError = 0 THEN
  begin
    fDeviceName := StrPas(RASConnStatus.szDeviceName);
    fDeviceType := StrPas(RASConnStatus.szDeviceType);
    ConnectState := RASConnStatus.rasconnstate;
  end;
  LastError := RASConnStatus.dwError;
  Result := LastError;
end;

function TRAS.GetConnections: LongInt;
var
  RASConnect: Array[1..MaxConnections] OF TRASConn;
  I,
  BufSize,
  NumConnections: Word;
begin
  Connections.Clear;
  RASConnect[1].dwSize := 30;
  BufSize := SizeOf(RASConnect);
  Result := RasEnumConnections(@RASConnect, BufSize, NumConnections);
  LastError := Result;
  If (Result = 0) OR (Result = ERROR_BUFFER_TOO_SMALL) THEN
     For I := 1 TO NumConnections DO
         If (I <= MaxConnections) THEN
            Connections.AddConnection(RASConnect[I]);
end;

function TRAS.GetPhoneBookEntries;
var
  RASEntryName: Array[1..20] Of TRASENTRYNAME;
  I,
  BufSize,
  Entries: Word;
  szPhoneBookPath: PChar;
begin
  PhoneBookEntries.Clear;
  RASEntryName[1].dwSize := 26;
  BufSize := SizeOf(RASEntryName);
  If fPhoneBookPath <> '' THEN
  Begin
    GetMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
    StrPCopy(szPhoneBookPath, fPhoneBookPath);
    Result := RasEnumEntries(Nil, szPhonebookPath, @RASEntryName,
                             BufSize, Entries);
    FreeMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
  End
  ELSE
    Result := RasEnumEntries(Nil, Nil, @RASEntryName, BufSize, Entries);
  LastError := Result;
  If (Result = 0) OR (Result = ERROR_BUFFER_TOO_SMALL) THEN
     For I := 1 TO Entries DO
         If ( I < 21) AND (RASEntryName[I].szEntryName[0] <> #0) THEN
            PhoneBookEntries.Add(StrPas(RASEntryName[I].szEntryName));
end;

procedure TRAS.WndProc(var Msg: TMessage);
begin
  If (Msg.Msg = RASEvent) AND (RASConn <> 0) THEN
  Begin
    If Msg.lParam <> 0 THEN
       LastError := Msg.lParam
    ELSE
    Begin
      ConnectState := Msg.wParam;
      Case ConnectState OF
           RASCS_DeviceConnected: Connected;
           RASCS_WaitForCallBack: WaitingForCallBack;
      End;
    End;
    CurrentStatus;
  End
  ELSE
     DefWindowProc(fWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

function TRAS.CurrentStatus: String;
begin
  Result := '';
  If (RASConn = 0) THEN
  Begin
    Result := 'Not Active';
    Exit;
  End;
  If RASConn <> 0 THEN
  Begin
    GetConnectStatus;
    If LastError <> 0 THEN
    Begin
      If LastError >= 600 THEN
         Result := GetErrorString(LastError)
      ELSE
      Case LastError OF
        6: Result := 'Invalid Handle';
        8: Result := 'Not enough memory';
      End;
    End
    ELSE
    Case ConnectState OF
     RASCS_OpenPort:
            Result := 'Opening Port';
     RASCS_PortOpened:
            Result := 'Port Opened';
     RASCS_ConnectDevice:
            Result := 'Using Device: ' + fDeviceName + ' - ' + fDeviceType;
     RASCS_DeviceConnected:
            Result := 'Device is connected';
     RASCS_AllDevicesConnected:
            Result := 'All Required Devices Connected';
     RASCS_Authenticate:
            Result := 'Validating User/Password/Domain';
     RASCS_AuthNotify:
            Result := 'Authentication Notification';
     RASCS_AuthCallBack:
            Result := 'Authentication Call Back';
     RASCS_AuthProject:
            Result := 'Project';
     RASCS_AuthLinkSpeed:
            Result := 'Calculating Link speed';
     RASCS_AuthAck:
            Result := 'Authentication acknowledged';
     RASCS_ReAuthenticate:
            Result := 'Reauthenticating';
     RASCS_Authenticated:
            Result := 'Login Authenticated';
     RASCS_PrepareforCallBack:
            Result := 'Preparing for Callback';
     RASCS_WaitForModemReset:
            Result := 'Waiting for Modem Reset';
     RASCS_WaitForCallBack:
            Result := 'Waiting for Callback';
    End; { Case }
  End
  ELSE
    Result := 'Not Connected';
end;

procedure TRAS.SetPhoneBookPath(Value: String);
begin
  fPhoneBookPath := Value;
  GetPhoneBookEntries;
end;

procedure TRAS.Connected;
begin
  If (RASConn = 0) THEN
     Exit;
  If Assigned(fOnConnect) THEN
     fOnConnect(Self);
end;

procedure TRAS.DisConnected;
begin
  If (RASConn = 0) THEN
     Exit;
  If Assigned(fOnDisConnect) THEN
     fOnDisConnect(Self);
end;

procedure TRAS.WaitingForCallBack;
begin
  If (RASConn = 0) THEN
     Exit;
  If Assigned(fOnCallBack) THEN
     fOnCallBack(Self);
end;

end.